home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue30 / shfileop / SHFILEOP.ZIP / LIB / SHFILEOP.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1997-08-25  |  4.5 KB  |  143 lines
  1. unit ShFileOp;
  2. {Component based on the ShFileOperation API function
  3.  Michel BURDIN - 1997}
  4.  
  5. interface
  6.  
  7. uses
  8.     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  9.     ShellApi;
  10.  
  11. type
  12.     TShFlags = (shAllowUndo, shFilesOnly, shNoConfirmation, shNoConfirmMkDir,
  13.              shRenameOnCollision, shSilent, shSimpleProgress);
  14.     TShFlag = Set of TShFlags;
  15.     TShOp = (shCopy, shDelete, shMove, shRename);
  16.     TShFileOP = class(TComponent)
  17.     private
  18.       fHParent: THandle;
  19.       fOperation: TShOp;
  20.       fTo: AnsiString;
  21.       fFlags: TShFlag;
  22.       fFromList: TStringList;
  23.       fAborted: boolean;
  24.       fTitle: AnsiString;
  25.       fKeepFilesList: boolean;
  26.       procedure SetFilesList(aList: TStringList);
  27.     protected
  28.  
  29.     public
  30.       constructor Create(aOwner: TComponent); override;
  31.       destructor Destroy; override;
  32.       function Execute: boolean;
  33.       property Aborted: boolean read fAborted;
  34.     published
  35.       property Operation: TShOp read fOperation write fOperation default shCopy;
  36.       property FilesList: TStringList read fFromList write SetFilesList;
  37.       property Destination: AnsiString read fTo write fTo;
  38.       property Title: AnsiString read fTitle write fTitle;
  39.       property Options: TShFlag read fFlags write fFlags default [shAllowUndo];
  40.       property KeepFilesList: boolean read fKeepFilesList write fKeepFilesList
  41.         default False;
  42.     end;
  43.  
  44. procedure Register;
  45.  
  46. implementation
  47.  
  48. procedure Register;
  49. begin
  50.     RegisterComponents('Samples', [TShFileOp]);
  51. end;
  52.  
  53. constructor TShFileOp.Create(aOwner: TComponent);
  54. begin
  55.        inherited Create(aOwner);
  56.        if (aOwner is TWinControl) then fHParent := TWinControl(aOwner).Handle
  57.        else fHParent := 0;
  58.        fOperation := shCopy;
  59.        fTo := '';
  60.        fFlags := [shAllowUndo];
  61.        fFromList := TStringList.Create;
  62.        fAborted := False;
  63.        fTitle := '';
  64.        fKeepFilesList := False;
  65. end;
  66. destructor TShFileOp.Destroy;
  67. begin
  68.        fFromList.Free;
  69.        inherited Destroy;
  70. end;
  71. function TShFileOp.Execute: boolean;
  72. var
  73.      TmpBuf: AnsiString;
  74.      shFO: TSHFileOpStruct;
  75.      i: Integer;
  76. begin
  77.        Result := True;
  78.        TmpBuf := '';
  79.        {Get source files}
  80.        if fFromList.Count > 0 then
  81.        {all filenames are put together in an unique buffer,
  82.         separated by a ; character + one at the end}
  83.        for i := 0 to fFromList.Count-1 do
  84.            if fFromList[i] <> '' then TmpBuf := TmpBuf + fFromList[i] + ';';
  85.        {No source files, bye bye!}
  86.        if TmpBuf = '' then exit;
  87.        {before using the buffer each ; must be replaced by a
  88.         null character. Therefore the buffer will end with
  89.         2 nulls (it's important)}
  90.        for i := 1 to Length(TmpBuf) do
  91.            if TmpBuf[i] = ';' then TmpBuf[i] := #0;
  92.        {PREPARE SHFILEOPSTRUCT STRUCTURE}
  93.        {--------------------------------------------------}
  94.        {The Hwnd of the parent window is necessary, otherwise
  95.         the task would be independant}
  96.        shFO.Wnd := fHParent;
  97.        {The operation to perform}
  98.        case fOperation of
  99.        shCopy:  shFO.wFunc := FO_COPY;
  100.        shDelete: shFo.wFunc := FO_DELETE;
  101.        shMove: shFo.wFunc := FO_MOVE;
  102.        shRename: shFo.wFunc := FO_RENAME;
  103.        end;
  104.        {List of source files}
  105.        shFO.pFrom := PAnsiChar(TmpBuf);
  106.        {destination : a directory or a filename}
  107.        shFO.pTo := PAnsiChar(fTo);
  108.        {some flags, of course}
  109.        shFO.fFlags := 0;
  110.        if shAllowUndo in fFlags then
  111.           shFO.fFlags := shFO.fFlags or FOF_ALLOWUNDO;
  112.        if shFilesOnly in fFlags then
  113.           shFO.fFlags := shFO.fFlags or FOF_FILESONLY;
  114.        if shNoConfirmation in fFlags then
  115.           shFO.fFlags := shFO.fFlags or FOF_NOCONFIRMATION;
  116.        if shNoConfirmMkDir in fFlags then
  117.           shFO.fFlags := shFO.fFlags or FOF_NOCONFIRMMKDIR;
  118.        if shRenameOnCollision in fFlags then
  119.           shFO.fFlags := shFO.fFlags or FOF_RENAMEONCOLLISION;
  120.        if shSilent in fFlags then
  121.           shFO.fFlags := shFO.fFlags or FOF_SILENT;
  122.        if shSimpleProgress in fFlags then
  123.           shFO.fFlags := shFO.fFlags or FOF_SIMPLEPROGRESS;
  124.        ShFO.fAnyOperationsAborted := False;
  125.        ShFO.hNameMappings := nil;  {not used, did not understand}
  126.        shFO.lpszProgressTitle := pAnsiChar(fTitle);
  127.        {Calling the following function will perform the action
  128.         It return 0 if everything is OK or <> 0 if an error occured}
  129.        Result := (ShFileOperation(shFO) = 0);
  130.        {Aborted indicates if the user cancelled the operation}
  131.        fAborted := ShFO.fAnyOperationsAborted;
  132.        {Clear the list for the next operation, except if
  133.         KeepFilesList is true}
  134.        if not fKeepFilesList then fFromList.Clear;
  135. end;
  136. procedure TShFileOp.SetFilesList(aList: TStringList);
  137. begin
  138.     {to avoid errors in design mode}
  139.     fFromList.Assign(aList);
  140. end;
  141. {THAT'S ALL, FOLKS!}
  142. end.
  143.